(use-modules
 ((srfi srfi-1) #:prefix srfi-1:))

;; =======
;; CHANGES
;; =======

;; This section lists differences to the book's code.

;; Some procedures have been renamed for better readability and compatibility
;; reasons:

;; elt -> element
;; random-elt -> random-element
;; car -> car/nil
;; mappend -> map-append

;; ===============================
;; Common Lisp compatibility layer
;; ===============================
(define NIL '())

(define element srfi-1:list-ref)

(define car/nil
  (lambda (possibly-empty-list)
    "In Common Lisp car of an empty list returns the empty list called NIL. In
Scheme it would be an error to call car on an empty list. We write a wrapper, to
avoid an error."
    (cond
     [(null? possibly-empty-list) NIL]
     [else (car possibly-empty-list)])))

(define rest
  (lambda (lst)
    (cond
     [(null? lst) NIL]
     [else (cdr lst)])))

(define assoc
  (lambda (key alist)
    (let ([res (srfi-1:assoc key alist)])
      (cond
       [res res]
       [else NIL]))))

;; =================
;; HELPER PROCEDURES
;; =================
(define displayln
  (lambda* (#:key (output-port (current-output-port)) . msgs)
    (display (string-append
              (string-join
               (map (lambda (msg) (simple-format #f "~s" msg)) msgs)
               " ") "\n")
             output-port)))

;; ======================
;; from previous chapters
;; ======================
(define map-append
  (lambda (proc lst)
    (apply append (map proc lst))))

;; ==============================
;; 2-02-straight-forward-solution
;; ==============================

;; helper functions
(define random-element
  (lambda (choices)
    (element choices (random (length choices)))))

(define one-of
  (lambda (set)
    "Choose one element of a given set of elements and return it. one-of returns
a list, so that the result can be appended to any other result."
    (list (random-element set))))

;; define the over all sentence structure
(define sentence
  (lambda ()
    (append (noun-phrase)
            (verb-phrase))))

(define noun-phrase
  (lambda ()
    (append (Article)
            (Noun))))

(define verb-phrase
  (lambda ()
    (append (Verb)
            (noun-phrase))))

;; terminal symbols
(define Article
  (lambda ()
    (one-of '(the a))))

(define Noun
  (lambda ()
    (one-of '(man ball woman table))))

(define Verb
  (lambda ()
    (one-of '(hit took saw liked))))

;; ========================
;; 2-03-rule-based-solution
;; ========================

;; define parameters, global constants, *name* naming-convention in scheme

(define *simple-grammar*
  '((sentence -> (noun-phrase verb-phrase))
    (noun-phrase -> (Article Noun))
    (verb-phrase -> (Verb noun-phrase))
    (Article -> the a)
    (Noun -> man ball woman table)
    (Verb -> hit took saw liked))
  #|A grammar for a trivial subset of English.|#)

(define *grammar* *simple-grammar*
  #|The grammar used by generate. Initially, this is *simple-grammar*, but we can switch to other grammars.|#)

;; define a data abstraction layer for accessing rules
(define rule-lhs
  (lambda (rule)
    "The left-hand side of a rule."
    (srfi-1:first rule)))

(define rule-rhs
  (lambda (rule)
    "The right-hand side of a rule."
    (rest (rest rule))))

(define rewrites
  (lambda (grammar category)
    "Return a list of the possible rewrites for this category."
    ;; (displayln "in rewrites")
    ;; (displayln "getting RHS of" category "from" grammar)
    ;; (displayln (assoc category grammar))
    (rule-rhs (assoc category grammar))))

;; write the generate procedure
(define generate
  (lambda (grammar phrase)
    (cond
     [(pair? phrase)
      ;; If we get a list of things, as for a previously rewritten expression,
      ;; we apply generate to all parts of the list and concattenate the result
      ;; into one list.
      (map-append (lambda (part)
                    (generate grammar part))
                  phrase)]
     [else
      ;; If we get a symbol, terminal or non-terminal, we try to get its choices
      ;; for substitution.
      (let ([choices (rewrites grammar phrase)])
        (cond
         [(null? choices)
          ;; If there are no choices, we are dealing with a terminal symbol. If
          ;; that is the case, we wrap the symbol into a list to be able to
          ;; append it to other previous substitutions.
          (list phrase)]
         [else
          ;; If there are choices, we are dealing with a non-terminal symbol. We
          ;; make a choice by choosing a random element.
          (generate grammar (random-element choices))]))])))

;; =========
;; EXERCISES
;; =========

;; EXERCISE 2.1
;; Write a version of generate that uses cond but avoids calling rewrites twice.
;; Already done, see code above.

;; EXERCISE 2.2
;; Write a version of generate that explicitly differentiates between terminal
;; symbols (those with no rewrite rules) and nonterminal symbols.

(define terminal?
  (lambda (grammar phrase)
    (null? (rewrites grammar phrase))))

(define non-terminal?
  (lambda (grammar phrase)
    (not terminal?)))

(define generate-explicit
  (lambda (grammar phrase)
    "This generate procedure uses explicit predicates, but is less performant,
because the check for terminal symbol requires looking the symbol up in the
grammar, but does not return the choices, if there are any and thus a second
lookup is potentially required later."
    (cond
     ;; could be a list of symbols
     [(pair? phrase)
      (map-append (lambda (part)
                    (generate-explicit grammar part))
                  phrase)]
     [(terminal? grammar phrase) (list phrase)]
     [else  ; non-terminal symbol
      (let ([choices (rewrites grammar phrase)])
        (generate-explicit grammar (random-element choices)))])))


;; Now we define a bigger grammar, to show, how the program can be modified and
;; extended, without changing the generate procedure.
(define *bigger-grammar*
  '((sentence -> (noun-phrase verb-phrase))

    (noun-phrase -> (Article Adjective* Noun PersonalPronoun*) (Name) (Pronoun))
    (verb-phrase -> (Verb noun-phrase PersonalPronoun*))

    (PersonalPronoun* -> () (PersonalPronoun PersonalPronoun*))
    (PersonalPronoun -> (Prep noun-phrase))

    (Adjective* -> () (Adjective Adjective*))
    (Adjective -> big little blue green adiabatic)

    (Prep -> to in by with on)
    (Article -> the a)
    (Name -> Pat Kim Lee Terry Robin)
    (Noun -> man ball woman table)
    (Verb -> hit took saw liked)
    (Pronoun -> he she it these those that)))

;; We can recognize implicit rules of how to read this grammar from looking at
;; the generate procedure:

;; 1. () is the epsilon or empty symbol. Appended to an unfinished (improper)
;; list, it ends a list.

;; 2. When symbols are wrapped in parentheses, generate will map itself to all
;; symbols in the parentheses. This is equivalent to saying, that a non-terminal
;; symbol will be substituted with multiple other symbols. Basically it is AND,
;; not an exclusive OR.

;; 3. When symbols are not wrapped in parentheses, one of them is chosen. This
;; is equivalent to making an exclusive OR choice.

;; We can use this grammar right away with the generate procedure.

;; Lets write a procedure, which takes the result of generate and writes it as a
;; string.

(define flatten-transform
  (lambda (lst-or-atom transformation)
    "Flatten an arbitrarily nested list and map a transformation recursively at
the same time."
    (cond
     [(null? lst-or-atom) '()]
     [(pair? lst-or-atom)
      (append (flatten-transform (car lst-or-atom) transformation)
              (flatten-transform (cdr lst-or-atom) transformation))]
     [else
      (list (transformation lst-or-atom))])))


(define to-string
  (lambda (parts)
    (with-output-to-string
      (lambda ()
        (display
         (string-append
          (string-join (flatten-transform parts symbol->string) " ")
          "."))))))

;; And for convenience define a procedure to output a random phrase.

(define display-sentence
  (lambda ()
    (displayln (to-string (generate *bigger-grammar* 'sentence)))))

;; Next we write a procedure, which does not only give us the terminal symbols,
;; but also the non-terminal symbols, which lead to the terminal symbols being
;; chosen in a tree structure. What sounds challenging at first becomes a small
;; modification of the generate procedure.

(define generate-tree
  (lambda (grammar phrase)
    (cond
     [(pair? phrase)
      ;; instead of map-append, we use map (or mapcar in common lisp).
      (map (lambda (part) (generate-tree grammar part))
           phrase)]
     [else
      (let ([choices (rewrites grammar phrase)])
        (cond
         [(null? choices)
          (list phrase)]
         [else
          ;; we cons the non-terminal to the non-terminal or terminal that is
          ;; produced from it, so that we have it in the result.
          (cons phrase
                (generate-tree grammar (random-element choices)))]))])))

;; Next we write a procedure, which generates not only one phrase from a given
;; symbol, but all possible phrases.

(define no-expansion '())

(define combine-all
  (lambda (xlist ylist)
    (map-append (lambda (y)
                  (map (lambda (x) (append x y))
                       xlist))
                ylist)))


(define generate-all
  (lambda (grammar symb-or-lst)
    "Generate a list of all possible expansions of the given symbol."
    (cond
     ;; In case we are given an empty list of symbols, we return the list
     ;; containing the empty expansion, which is the empty list itself.
     [(null? symb-or-lst) (list no-expansion)]
     ;; In case we get a list of symbols to substitute for, we combine all
     ;; possibilities of substituting the first symbol with all possibilities of
     ;; substituting the rest of the symbols. This is done using recursive
     ;; calls.
     [(pair? symb-or-lst)
      (combine-all (generate-all grammar (srfi-1:first symb-or-lst))
                   (generate-all grammar (cdr symb-or-lst)))]
     ;; Otherwise ...
     [else
      (let ([choices (rewrites grammar symb-or-lst)])
        (cond
         ;; ... if it is a terminal symbol, return a list of the possible
         ;; expansions, which are only one, the terminal itself. Since it is a
         ;; complete expansion, we wrap it in a list.
         [(null? choices) (list (list symb-or-lst))]
         ;; If there are choices for expansions, generate all expansions for the
         ;; choices and return the list of possible expansions.
         [else
          (map-append (lambda (choice) (generate-all grammar choice))
                      choices)]))])))


;; Exercise 2.3

;; Write a trivial grammar for some other language. This can be a natural
;; language other than English, or perhaps a subset of a computer language.

(define *chess-phrase-grammar*
  '((PHRASE
     ->
     NORMAL-PHRASE
     CHECK-PHRASE
     OFFER-DRAW-PHRASE
     CHECKMATE-PHRASE)
    (NORMAL-PHRASE
     -> (PIECE from FIELD to FIELD))
    (CHECK-PHRASE
     -> (PIECE from FIELD to FIELD check))
    (OFFER-DRAW-PHRASE
     -> (PIECE from FIELD to FIELD draw))
    (CHECKMATE-PHRASE
     -> (PIECE from FIELD to FIELD checkmate))
    (PIECE
     -> pawn knight bishop rook queen king)
    (FIELD
     ->
     a1 a2 a3 a4 a5 a6 a7 a8
     b1 b2 b3 b4 b5 b6 b7 b8
     c1 c2 c3 c4 c5 c6 c7 c8
     d1 d2 d3 d4 d5 d6 d7 d8
     e1 e2 e3 e4 e5 e6 e7 e8
     f1 f2 f3 f4 f5 f6 f7 f8
     g1 g2 g3 g4 g5 g6 g7 g8
     h1 h2 h3 h4 h5 h6 h7 h8)))

;; And try it out ...

#;(displayln
 (to-string
  (generate *chess-phrase-grammar* 'PHRASE)))

;; Exercise 2.4

;; One way of describing combine-all is that it calculates the cross-product of
;; the function append on the argument lists. Write the higher-order function
;; cross-product, and define combine-all in terms of it.

;; The moral is to make your code as general as possible, because you never know
;; what you may want to do with it next.

(define cross-product
  (lambda (xlist ylist op)
    ;; Append all partial results into a long list.
    (map-append
     ;; Make a list by applying an operation to all elements of ylist.
     (lambda (y)
       ;; Apply the operation to all pairs of elements from xlist and ylist.
       (map (lambda (x) (op x y)) xlist))
     ylist)))


(define combine-all-2
  (lambda (xlist ylist)
    (cross-product xlist
                   ylist
                   ;; This does not assume lists as inputs, like append does.
                   (lambda (a b)
                     (cons a (cons b '()))))))

(define generate-all-2
  (lambda (grammar symb-or-lst)
    "Generate a list of all possible expansions of the given symbol."
    (cond
     [(null? symb-or-lst) (list no-expansion)]
     [(pair? symb-or-lst)
      (combine-all (generate-all-2 grammar (srfi-1:first symb-or-lst))
                   (generate-all-2 grammar (cdr symb-or-lst)))]
     [else
      (let ([choices (rewrites grammar symb-or-lst)])
        (cond
         [(null? choices) (list (list symb-or-lst))]
         [else
          (map-append (lambda (choice) (generate-all-2 grammar choice))
                      choices)]))])))
